home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / lib / xt / popup.c < prev    next >
C/C++ Source or Header  |  1990-09-03  |  1KB  |  52 lines
  1. #include "xt.h"
  2.  
  3. static SYMDESCR Grab_Kind_Syms[] = {
  4.     { "grab-none",         XtGrabNone },
  5.     { "grab-nonexclusive", XtGrabNonexclusive },
  6.     { "grab-exclusive",    XtGrabExclusive },
  7.     { 0, 0 }
  8. };
  9.  
  10. static Object P_Create_Popup_Shell (argc, argv) Object *argv; {
  11.     ArgList a;
  12.     char *name = 0;
  13.     Object x = argv[0], class, parent, ret;
  14.     Declare_C_Strings;
  15.  
  16.     if (TYPE(x) != T_Class) {
  17.     Make_C_String (x, name);
  18.     argv++; argc--;
  19.     }
  20.     class = argv[0];
  21.     parent = argv[1];
  22.     Check_Type (class, T_Class);
  23.     Check_Widget (parent);
  24.     if (name == 0)
  25.     name = CLASS(class)->name;
  26.     Encode_Arglist (argc-2, argv+2, a, (Widget)0, CLASS(class)->class);
  27.     ret = Make_Widget (XtCreatePopupShell (name, CLASS(class)->class,
  28.     WIDGET(parent)->widget, a, (Cardinal)(argc-2)/2));
  29.     Dispose_C_Strings;
  30.     return ret;
  31. }
  32.  
  33. static Object P_Popup (shell, grab_kind) Object shell, grab_kind; {
  34.     Check_Widget (shell);
  35.     XtPopup (WIDGET(shell)->widget, Symbols_To_Bits (grab_kind, 0,
  36.     Grab_Kind_Syms));
  37.     return Void;
  38. }
  39.  
  40. static Object P_Popdown (shell) Object shell; {
  41.     Check_Widget (shell);
  42.     XtPopdown (WIDGET(shell)->widget);
  43.     return Void;
  44. }
  45.  
  46. init_xt_popup () {
  47.     Define_Primitive (P_Create_Popup_Shell, "create-popup-shell",
  48.                         2, MANY, VARARGS);
  49.     Define_Primitive (P_Popup,   "popup",   2, 2, EVAL);
  50.     Define_Primitive (P_Popdown, "popdown", 1, 1, EVAL);
  51. }
  52.